home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / _CATCURR.PRG < prev    next >
Text File  |  1993-05-04  |  4KB  |  124 lines
  1. PROCEDURE _CatCurr
  2. PARAMETER pc_result
  3. *--------------------------------------------------------------------
  4. * NAME
  5. *   _CatCurr - Get the current catalog
  6. *
  7. * DESCRIPTION
  8. *   The _CatCurr procedure will return the current catalog name
  9. *   regardless of the state of the catalog.  CatCurr
  10. *   will use the CATALOG() function first.  If that does not work,
  11. *   it will try to open the first CATALOG.CAT in the PATH and use
  12. *   it.  _CatCurr() will then use the ALIAS value for
  13. *   the last record in CATALOG.CAT as the return value.
  14. *
  15. *   If _CatCurr cannot find a CATALOG.CAT file,
  16. *   it will return a blank value.  The return value will have
  17. *   no PATH prefix.
  18. *
  19. *   _CatCurr() overcomes the oversight of the
  20. *   CATALOG() function returning a value only if a CATALOG
  21. *   is active.
  22. *
  23. * SYNOPSYS
  24. *   DO _CatCurr WITH <pc_result>
  25. *
  26. * PARAMETERS
  27. *   pc_result   = Name if the catalog file.  Blank if a catalog is
  28. *                 not located.  It is forced to blank at the start.
  29. *
  30. * EXAMPLE
  31. *   SET CATALOG TO samples
  32. *   ? CATALOG()                         && Built in returns "SAMPLES.CAT"
  33. *   lc_catname = ""
  34. *   DO _CatCurr WITH lc_catname         && lc_catname equals "SAMPLES.CAT"
  35. *
  36. *   SET CATALOG TO                      && Shut down the catalog
  37. *   ? CATALOG()                         && Built in returns ""
  38. *   DO _CatCurr WITH lc_catname         && lc_catname equals "SAMPLES.CAT"
  39. *
  40. * LIMITATIONS
  41. *   Fields must be off, Talk must be off
  42. *
  43. * DEPENDENCIES
  44. *   Called by:  _CatOpen  - Open the current catalog file
  45. *
  46. * VARIABLES
  47. *   ll_fpath    = State of FULLPATH, .T. if on, .F. if off
  48. *   ll_delete   = State of DELETE,   .T. if on, .F. if off
  49. *   ll_catalog  = State of CATALOG,  .T. if on, .F. if off
  50. *   lc_alias    = Current WA alias in use
  51. *   lc_hcat     = Full path name of CATALOG.CAT in the dBASE HOME() dir
  52. *
  53. *--------------------------------------------------------------------
  54.   PRIVATE ll_fpath, ll_delete, lc_alias, lc_hcat
  55.  
  56.   pc_result = ""                        && Catalog name to return
  57.  
  58.   ll_fpath = SET("FULLPATH") = "ON"     && Save the fullpath state
  59.   SET FULLPATH ON                       && Force fullpath on
  60.  
  61.   pc_result = CATALOG()                 && Try the catalog() first
  62.  
  63.   *-- If no catalog, look for the catalog using the dBASE search method
  64.   IF ISBLANK( pc_result )
  65.  
  66.     lc_alias = ALIAS()                  && Save the current alias
  67.     SELECT SELECT()                     && Get a new work area
  68.  
  69.     ll_catalog = SET( "CATALOG" ) = "ON"
  70.     SET CATALOG OFF
  71.     ON ERROR DO _F_Error
  72.  
  73.     *-- Check for CATALOG.CAT in PATH
  74.     IF FILE( "catalog.cat" )
  75.       USE catalog.cat ALIAS FXCatCat AGAIN NOUPDATE NOLOG
  76.  
  77.     ELSE
  78.  
  79.       lc_hcat = HOME() + "CATALOG.CAT"  && Form the home directory cat name
  80.  
  81.       IF FILE( lc_hcat )                && If the home catalog.cat exists
  82.  
  83.         USE ( lc_hcat ) ALIAS FXCatCat AGAIN NOUPDATE NOLOG
  84.  
  85.       ENDIF
  86.  
  87.     ENDIF
  88.  
  89.     *-- Check for open CATALOG.CAT with DBF()
  90.     IF .NOT. ISBLANK( DBF() )
  91.  
  92.       ll_delete = SET( "DELETE" ) = "ON"  && Save the delete state
  93.       SET DELETE ON                     && Do not show deleted records
  94.  
  95.       GO BOTTOM                         && Move to the current cat record
  96.       pc_result = UPPER( TRIM( path ) ) && Store file name to the result
  97.       USE                               && Close Catalog.cat
  98.  
  99.       IF .NOT. ll_delete                && If delete was off before
  100.         SET DELETE OFF                  && Set delete off
  101.       ENDIF
  102.  
  103.     ELSE
  104.       RELEASE FXL_Error
  105.     ENDIF
  106.  
  107.     IF .NOT. ISBLANK( lc_alias )        && If a file was open before
  108.       SELECT ( lc_alias )               && Reset the work area back
  109.     ENDIF
  110.  
  111.     IF ll_catalog
  112.       SET CATALOG ON
  113.     ENDIF
  114.  
  115.   ENDIF
  116.  
  117.   IF .NOT. ll_fpath                     && If fullpath was off before
  118.     SET FULLPATH OFF                    && Set fullpath back off
  119.   ENDIF
  120.  
  121. RETURN
  122. *-- EOP:  _CatCurr WITH pc_result
  123.  
  124.